home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 6 / CU Amiga Magazine's Super CD-ROM 06 (1996)(EMAP Images)(GB)(Track 1 of 4)[!][issue 1997-01].iso / cucd / prog / mui / modula / demo / class1.mod < prev    next >
Text File  |  1996-02-07  |  9KB  |  295 lines
  1. MODULE Class1;
  2.  
  3. (*$ StackChk:=FALSE   NilChk:=FALSE   EntryClear:=FALSE
  4.     RangeChk:=FALSE
  5. *)
  6.  
  7.  
  8. (*
  9. ** Class1
  10. ** the M2 interpretation of the famous class written by Stefan Stuntz
  11. ** for MUI in C.
  12. ** This demonstration was performed by Christian 'Kochtopf' Scholz in
  13. ** order to show how the same is done in M2.
  14. ** (ofcourse inspired by class1.c ;-)   )
  15. **
  16. ** Updated Nov 27, 1995 by Olaf Peters:
  17. **  - does not use MUIOBSOLETE tags any longer
  18. **  - uses "the ideal input loop for an object oriented MUI application"
  19. **      (see MUI_Application.doc/MUIM_Application_NewInput)
  20. **
  21. ** please note that there are some foldmarkers inside this file, which
  22. ** are used by GoldEd.
  23. *)
  24.  
  25. (*{{{  "Imports" *)
  26.  
  27. IMPORT MD:MuiD;
  28. IMPORT ML:MuiL;
  29. IMPORT MM:MuiMacros;
  30. IMPORT R;
  31. IMPORT Arts;
  32. FROM SYSTEM     IMPORT ADDRESS, LONGSET, TAG, CAST, ADR;
  33. FROM DosD       IMPORT ctrlC ;
  34. FROM ExecL      IMPORT Wait;
  35. FROM MuiMacros  IMPORT MakeHook, HookDef, NoteClose, set;
  36. FROM MuiSupport IMPORT fail, DoMethod, DOMethod;
  37. FROM IntuitionD IMPORT IClassPtr, ObjectPtr, DrawPens, DrawInfo, Msg, IClass;
  38. FROM IntuitionL IMPORT FreeClass, MakeClass, NewObjectA;
  39. FROM MuiClasses IMPORT mpAskMinMax, mpAskMinMaxPtr, mpDraw, mpDrawPtr,
  40.                        MADFlagSet, MADFlags,
  41.                        OBJ_rp, OBJ_dri, OBJ_mleft, OBJ_mtop, OBJ_mbottom, OBJ_mright,
  42.                        mpSetup, mMinMax, FillMinMaxInfo, MakeDispatcher;
  43. FROM AmigaLib   IMPORT DoSuperMethodA;
  44. FROM GraphicsL  IMPORT SetAPen, Move, Draw;
  45. FROM GraphicsD  IMPORT RastPortPtr;
  46. FROM UtilityD   IMPORT HookPtr, Hook, tagDone, tagEnd;
  47. FROM Terminal   IMPORT Format;
  48.  
  49. (*}}}*)
  50. (*{{{  "the class" *)
  51.  
  52. (***************************************************************************)
  53. (* Here is the beginning of our simple new class...                        *)
  54. (***************************************************************************)
  55.  
  56. (*
  57. ** This is an example for the simplest possible MUI class. It's just some
  58. ** kind of custom image and supports only two methods:
  59. ** mAskMinMax and mDraw.
  60. *)
  61.  
  62. (*
  63. ** This is the instance data for our custom class.
  64. ** Since it's a very simple class, it contains just a dummy entry.
  65. *)
  66.  
  67. TYPE Data = RECORD
  68.                 dummy       :   LONGINT;
  69.             END;
  70.  
  71. VAR  MyData     :   Data;
  72.  
  73. (*{{{  "mAskMinMax" *)
  74. (*
  75. ** AskMinMax method will be called before the window is opened
  76. ** and before layout takes place. We need to tell MUI the
  77. ** minimum, maximum and default size of our object.
  78. *)
  79.  
  80. PROCEDURE mAskMinMax(cl : IClassPtr; obj : ObjectPtr; msg : mpAskMinMaxPtr) : ADDRESS;
  81.     VAR     dummy   : ADDRESS;
  82.     BEGIN
  83.         (*
  84.         ** let our superclass first fill in what it thinks about sizes.
  85.         ** this will e.g. add the size of frame and inner spacing.
  86.         *)
  87.  
  88.         dummy:=DoSuperMethodA(cl,obj,msg);
  89.  
  90.         (*
  91.         ** now add the values specific to our object. note that we
  92.         ** indeed need to *add* these values, not just set them!
  93.         *)
  94.  
  95.         msg^.MinMaxInfo^.MinWidth  := msg^.MinMaxInfo^.MinWidth +100;
  96.         msg^.MinMaxInfo^.DefWidth  := msg^.MinMaxInfo^.DefWidth +120;
  97.         msg^.MinMaxInfo^.MaxWidth  := msg^.MinMaxInfo^.MaxWidth +500;
  98.  
  99.         msg^.MinMaxInfo^.MinHeight := msg^.MinMaxInfo^.MinHeight +40;
  100.         msg^.MinMaxInfo^.DefHeight := msg^.MinMaxInfo^.DefHeight +90;
  101.         msg^.MinMaxInfo^.MaxHeight := msg^.MinMaxInfo^.MaxHeight +300;
  102.  
  103.         (*
  104.         ** please note that there is a PROCEDURE defined in MUIClasses,
  105.         ** which does the settings of the MinMaxInfo.
  106.         ** just call
  107.         **  FillMinMaxInfo(msg, 100, 120, 500, 40, 90, 300);
  108.         ** in order to do the same as above in one line.
  109.         *)
  110.  
  111.         RETURN NIL;
  112.     END mAskMinMax;
  113. (*}}}*)
  114. (*{{{  "mDraw" *)
  115. (*
  116. ** Draw method is called whenever MUI feels we should render
  117. ** our object. This usually happens after layout is finished
  118. ** or when we need to refresh in a simplerefresh window.
  119. ** Note: You may only render within the rectangle
  120. **       OBJ_mleft(obj), OBJ_mtop(obj), OBJ_mwidth(obj), OBJ_mheight(obj).
  121. *)
  122.  
  123. PROCEDURE mDraw(cl : IClassPtr; obj : ObjectPtr; msg : mpDrawPtr) : ADDRESS;
  124.     VAR
  125.             i       : INTEGER;
  126.             dummy   : ADDRESS;
  127.             mt, ml, mr, mb : INTEGER;
  128.  
  129.     BEGIN
  130.  
  131.         (*
  132.         ** let our superclass draw itself first, area class would
  133.         ** e.g. draw the frame and clear the whole region. What
  134.         ** it does exactly depends on msg->flags.
  135.         *)
  136.  
  137.         dummy:=DoSuperMethodA(cl,obj,msg);
  138.  
  139.         (*
  140.         ** if drawObject isn't in MADFlagSet, we shouldn't draw anything.
  141.         ** MUI just wanted to update the frame or something like that.
  142.         *)
  143.  
  144.         IF (drawObject IN msg^.flags) THEN
  145.  
  146.             (*
  147.             ** ok, everything ready to render...
  148.             *)
  149.  
  150.             mt:=OBJ_mtop(obj);
  151.             ml:=OBJ_mleft(obj);
  152.             mr:=OBJ_mright(obj);
  153.             mb:=OBJ_mbottom(obj);
  154.  
  155.  
  156.             SetAPen(OBJ_rp(obj), OBJ_dri(obj)^.pens^[textPen]);
  157.  
  158.             FOR i:=ml TO mr BY 5 DO
  159.                 Move(OBJ_rp(obj), ml, mb);
  160.                 Draw(OBJ_rp(obj), i, mt);
  161.                 Move(OBJ_rp(obj), mr, mb);
  162.                 Draw(OBJ_rp(obj), i, mt);
  163.             END;
  164.  
  165.         END; (* if *)
  166.  
  167.         RETURN NIL;
  168.  
  169.     END mDraw;
  170.  
  171. (*}}}*)
  172. (*{{{  "MyDispatcher" *)
  173. (*
  174. ** Here comes the dispatcher for our custom class. We only need to
  175. ** care about mAskMinMax and mDraw in this simple case.
  176. ** Unknown/unused methods are passed to the superclass immediately.
  177. *)
  178.  
  179. PROCEDURE MyDispatcher(cl : IClassPtr; obj : ADDRESS; msg : ADDRESS) : ADDRESS;
  180.  
  181.     BEGIN
  182.  
  183.         (* sorry, no CASE here, because the range is too big... *)
  184.  
  185.         IF CAST(Msg, msg)^.methodID=MD.mmAskMinMax THEN
  186.             RETURN mAskMinMax(cl, obj, msg);
  187.         ELSIF CAST(Msg, msg)^.methodID=MD.mmDraw THEN
  188.             RETURN mDraw(cl, obj,msg);
  189.         ELSE
  190.             RETURN DoSuperMethodA(CAST(IClassPtr, cl), obj, msg);
  191.         END;
  192.  
  193.     END MyDispatcher;
  194.  
  195. (*}}}*)
  196. (*}}}*)
  197. (***************************************************************************)
  198. (* Thats all there is about it. Now lets see how things are used...        *)
  199. (***************************************************************************)
  200. (*{{{  "VAR" *)
  201. VAR app, window, MyObj, SuperClass  : MD.APTR;
  202.     myObj                           : MD.APTR;
  203.     MyClass                         : IClassPtr;
  204.     signals                         : LONGSET;
  205.     myHookPtr                       : HookPtr;
  206.     buffer, buffer2                 : ARRAY[0..60] OF LONGINT;
  207.     NULL                            :=ADDRESS{NIL};
  208.     du                              : BOOLEAN;
  209. (*}}}*)
  210. (*{{{  "usage of the class" *)
  211. BEGIN
  212.  
  213.     (* Get a pointer to the superclass. MUI will lock this *)
  214.     (* and prevent it from being flushed during you hold   *)
  215.     (* the pointer. When you're done, you have to call     *)
  216.     (* moFreeClass() to release this lock.                 *)
  217.  
  218.     SuperClass:=ML.moGetClass(ADR(MD.mcArea));
  219.     IF SuperClass=NIL THEN fail(NULL, "Superclass for the new class not found,"); END;
  220.  
  221.     (* create the new class *)
  222.     MyClass:=MakeClass(NIL, NIL, SuperClass, SIZE(MyData), LONGSET{});
  223.     IF MyClass=NIL THEN
  224.         ML.moFreeClass(SuperClass);
  225.         fail(NULL, "Failed to create class!");
  226.     END;
  227.  
  228.     (* set the dispatcher for the new class *)
  229.  
  230.     MakeDispatcher(MyDispatcher, MyClass);
  231.  
  232.  
  233.     (* create a little GUI with our new class *)
  234.  
  235.     MyObj   := NewObjectA(MyClass, NIL, TAG(buffer,
  236.                                 MD.maFrame,             MD.mvFrameText,
  237.                                 MD.maBackground,        MD.miBACKGROUND,
  238.                                 tagDone));
  239.  
  240.     window  := MM.WindowObject(TAG(buffer,
  241.                     MD.maWindowTitle,           ADR("A test of our custom class"),
  242.                     MM.WindowContents,          MM.VGroup(TAG(buffer2,
  243.                                                     MM.Child,       MyObj,
  244.                                                     tagEnd)),
  245.                     tagEnd));
  246.  
  247.     app   := MM.ApplicationObject(TAG(buffer,
  248.         MD.maApplicationTitle,        ADR("M2Class1"),
  249.         MD.maApplicationAuthor,       ADR("Christian Scholz and Stefan Stuntz"),
  250.         MD.maApplicationVersion,      ADR("$VER: M2Class1 1.0 (18.04.94)"),
  251.         MD.maApplicationCopyright,    ADR("© KT SS"),
  252.         MD.maApplicationDescription,  ADR("demonstrates how to write own classes in M2!"),
  253.         MD.maApplicationBase,         ADR("M2CLASS1"),
  254.         MM.SubWindow,                 window,
  255.         tagEnd));
  256.  
  257.  
  258.     IF app=NIL THEN fail(app, "failed to create application!!"); END;
  259.  
  260.     NoteClose(app, window, MD.mvApplicationReturnIDQuit);   (* set up a notify on closing the window *)
  261.  
  262.  
  263. (*
  264. ** Input loop...
  265. *)
  266.  
  267.     set(window,MD.maWindowOpen,1);
  268.  
  269.     signals := LONGSET{} ;
  270.  
  271.     LOOP
  272.       IF DOMethod(app, TAG(buffer, MD.mmApplicationNewInput, ADR(signals))) = MD.mvApplicationReturnIDQuit THEN EXIT END ;
  273.  
  274.       IF signals # LONGSET{} THEN
  275.         INCL(signals, ctrlC) ;
  276.         signals := Wait(signals) ;
  277.         IF ctrlC IN signals THEN EXIT END ;
  278.       END (* IF *) ;
  279.     END (* WHILE *) ;
  280.  
  281.     set(window,MD.maWindowOpen,0);
  282.  
  283.  
  284. (*
  285. ** Shut down...
  286. *)
  287.  
  288.     ML.mDisposeObject(app);             (* free our application resources *)
  289.     du:=FreeClass(MyClass);             (* free our own class *)
  290.     ML.moFreeClass(SuperClass);         (* free our SuperClass *)
  291.     fail(NULL,"");                      (* and the end..... *)
  292. (*}}}*)
  293. END Class1.
  294.  
  295.